home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 008 / cadence.arc / VOL2NO1.ARC / FLEXD.LSP < prev   
Encoding:
Text File  |  1987-05-18  |  3.3 KB  |  102 lines

  1. ; ================================================================
  2. ;
  3. ;   FLEXD.LSP           Revised 2/87   Bill Kramer
  4. ;   Revisions for AutoCAD 2.5+
  5. ;   ----------------------------------------------------------
  6. ;   Changes applied:
  7. ;    1.  Use of GETPOINT with "anchor point" for rubber banding input.
  8. ;    2.  Added LINE terminators to COMMAND expressions using LINE.
  9. ;    3.  Replaced REDRAW command with expression (redraw).
  10. ;    4.  Renamed TURN so that both DUCT.LSP & FLEXD.LSP work in
  11. ;        "harmony".  New name is fxTURN for Flex Duct work.
  12. ;
  13. ; ================================================================
  14. ;FLEXD PROGRAM
  15. (DEFUN STRGT ()
  16. ; (COMMAND "DIST" P1) (GETPOINT "\nENTER END POINT OF FLEX DUCT :")
  17. ; (COMMAND) 
  18. ; (SETQ P2 (GETVAR "LASTPOINT"))   <--- See notes in next function. 
  19.  (setq p2 (getpoint p1 "\nEnter End Point of flex duct :"))
  20.  (SETQ Z (+ (ANGLE P1 P2) 1.57079633))
  21.  (SETQ PX (POLAR P1 (ANGLE P1 P2) 9))
  22.  (SETQ P1A (POLAR PX (+ Z 3.14159265) (* W 0.5)))
  23.  (SETQ P1B (POLAR P1A Z W))
  24.  (SETQ P1D (POLAR P1 Z (+ W2 7)))
  25.  (SETQ P1C (POLAR P1 (+ Z 3.1415926) (+ W2 7)))
  26.  (SETQ P2B (POLAR P2 Z W2))
  27.  (SETQ P2A (POLAR P2 (+ Z 3.1415926) W2))
  28.  (COMMAND "LINE" P1D P1B P1A P1C "")
  29.  (COMMAND "LINE" P1A P2A "")
  30.  (COMMAND "LINE" P1B P2B "")
  31.  (SETQ P1 P2)
  32.  (SETQ P1A P2A)
  33.  (SETQ P1B P2B))
  34. (DEFUN fxTURN ()
  35. ;   This combination of expressions is converted to....
  36. ;
  37. ; (COMMAND "DIST" P1) (GETPOINT "\nENTER TURNING POINT OF DUCT: ")
  38. ; (COMMAND)
  39. ; (SETQ P2 (GETVAR "LASTPOINT"))
  40. ;
  41. ;   .... this single expression for AutoCAD 2.5+
  42. ;
  43.  (setq P2 (getpoint P1 "\nEnter Turning point of Duct: "))
  44. ;
  45. ;   This combination of expression is converted to....
  46. ;
  47. ; (COMMAND "DIST" P2) (GETPOINT "\nENTER END OF FLEX DUCT: ")
  48. ; (COMMAND)
  49. ; (SETQ P3 (GETVAR "LASTPOINT"))
  50. ;
  51. ;   .... this single expression for AutoCAD 2.5+
  52. ;
  53.  (setq P3 (getpoint P2 "\nEnter end of Flex Duct: "))
  54. ;
  55.  (SETQ Z (+ (ANGLE P1 P2) 1.57079633))
  56.  (SETQ PX (POLAR P1 (ANGLE P1 P2) 9))
  57.  (SETQ P1A (POLAR PX (+ Z 3.14159265) (* W 0.5)))
  58.  (SETQ P1B (POLAR P1A Z W))
  59.  (SETQ P1D (POLAR P1 Z (+ W2 7)))
  60.  (SETQ P1C (POLAR P1 (+ Z 3.1415926) (+ W2 7)))
  61.  (SETQ Z2 (+ (ANGLE P2 P3) 1.57079633))
  62.  (SETQ P2B (POLAR P2 Z W2))
  63.  (SETQ P2A (POLAR P2 (+ Z 3.1415926) W2))
  64.  (SETQ P2AA (POLAR P2 (+ Z2 3.1415926) W2))
  65.  (SETQ P2BB (POLAR P2 Z2 W2))
  66.  (SETQ P3B (POLAR P3 Z2 W2))
  67.  (SETQ P3A (POLAR P3 (+ Z2 3.1415926) W2))
  68.  (COMMAND "LINE" P1C P1A P1B P1D "")
  69.  (COMMAND "LINE" P1A P2A "")
  70.  (COMMAND "LINE" P1B P2B "")
  71.  (COMMAND "LINE" P2AA P3A "")
  72.  (COMMAND "LINE" P2BB P3B "")
  73.  (SETQ D2 (DISTANCE P1 P2AA))
  74.  (SETQ D1 (DISTANCE P1 P2BB))
  75.  (IF (> D2 D1) (SETQ RB W) (SETQ RB (* 2 W)))
  76.  (IF (> D2 D1) (SETQ RA (* W 2)) (SETQ RA W))
  77.  (COMMAND "FILLET" "R" RB)
  78.  (COMMAND "FILLET" P2B P2BB)
  79.  (COMMAND "FILLET" "R" RA)
  80.  (COMMAND "FILLET" P2A P2AA)
  81.  (SETQ P1 P3)
  82.  (SETQ P1A P3A)
  83.  (SETQ P1B P3B)
  84. )
  85. ;
  86. (DEFUN C:FLEXD ()
  87.  (SETVAR "CMDECHO" 0)
  88.  (SETQ W (GETREAL "\nPICK DUCT WIDTH: "))
  89.  (SETQ W2 (* W 0.5))
  90.  (SETQ P1 (GETPOINT "\nENTER BEGINNING OF CENTERLINE: "))
  91.  (SETQ L T)
  92.  (WHILE L
  93.   (setq Test
  94.       (strcase
  95.         (getstring "\nIs direction <S>traight or <T>urn or <Q>uit:")))
  96.   (IF (EQUAL TEST "S") (STRGT))
  97.   (IF (EQUAL TEST "T") (fxTURN))
  98.   (IF (EQUAL TEST "Q") (SETQ L NIL)))
  99.  (COMMAND "LINE" P1A P1B "")
  100. (redraw) 
  101. )
  102.